perm filename REQALL.1[AID,LSP] blob sn#426681 filedate 1979-03-14 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare (fasload util fas dsk (aid rpg)))
C00004 ENDMK
CāŠ—;
(declare (fasload util fas dsk (aid rpg)))
(declare (*fexpr dir)(*expr eload))

(defun require-all fexpr (files)
 (let dir ← (dir) do
      (for file ε files do
       (funcall 'eload (cond ((atom file)(list file (rqudir file dir)))
			     (t file))))))

(macrodef shrink-name (x)
	  ((lambda (n)
		   (cond ((< 6 n)
			  (do ((i (nreverse (explode x))
			   (cdr i))
			(j (- n 6) (1- j)))
		       ((zerop j) (implode (nreverse i)))))
		  (t x)))
	    (length (explode x))))

(defun rqudir (name dir)
 (declare (fixnum n j))
 (setq name (shrink-name name))
 ((lambda (best best-ext filename base ibase)
  (mapc (function (lambda (entry)
		   (and (eq (car entry) filename)
		    ((lambda (ext)
		      (cond ((and ext
				 (numberp ext))
			     (cond ((numberp best)
				    (cond ((> ext best)
				   	   (setq best ext best-ext (cadr entry)))))  
				   (t (setq best ext best-ext (cadr entry)))))))
		     (readlist (explodec (cadr entry)))))))    
	dir) best-ext)
  nil nil name 10. 10.))